home *** CD-ROM | disk | FTP | other *** search
/ Amoszine 3 / Amoszine 3.adf / MORE_SOURCE / intuition.amos.pp / intuition.amos / intuition.amosSourceCode
AMOS Source Code  |  1992-02-26  |  8KB  |  501 lines
  1. ' ****************** 
  2. ' * AMOS Intuition * 
  3. ' ****************** 
  4.  
  5. ' *** Original Program Supplied With AMOS Professional,
  6. '     Requester Procedures & Close Gadget Written By John.A.Kinsella.
  7.  
  8. ' *** Define WB Variable.
  9.  
  10. Dim WINCON(1)
  11.  
  12. ' *** Switch To CLI. 
  13.  
  14. Amos To Back 
  15.  
  16. ' *** Open Window. 
  17.  
  18. _WINDOPEN[1,0,0,640,100,"<- Quits...",1]
  19.  
  20. ' *** Set Character Codes. 
  21.  
  22. M$=Chr$(10)
  23. E$=Chr$($9B)+"3;31;42m"
  24. B$=Chr$($9B)+"1;31;42m"
  25. O$=Chr$($9B)+"0m"
  26.  
  27. ' *** Print Text.
  28.  
  29. _WPRINT[1,Chr$(10)]
  30. _WPRINT[1,E$+" AMOS Intuition Example... "+O$]
  31. _WPRINT[1,Chr$(10)]
  32. _WPRINT[1,Chr$(10)]
  33. _WPRINT[1,B$+" Use BUTTON, REQUESTER or ENDCLI keywords..."+O$]
  34. _WPRINT[1,Chr$(10)]
  35.  
  36. ' *** MAIN LOOP. 
  37.  
  38. Do 
  39.    1
  40.    
  41.    ' *** Display prompt.
  42.    
  43.    _WPRINT[1,M$+"AMOS> "]
  44.    
  45.    ' *** Read Input (160 Characters). 
  46.    
  47.    _WINPUT[1,160]
  48.    
  49.    ' *** Check For File-Requester.
  50.    
  51.    If Upper$(CHAR$)="REQUESTER"
  52.       
  53.       ' *** Call file requester. 
  54.       
  55.       _WFILREQ["Ram Disk:"]
  56.       
  57.       ' *** Display Selected File. 
  58.       
  59.       If ERR=-1
  60.          _WPRINT[1,"File Selected = '"+FIL$+"'"]
  61.          Print F$
  62.          Goto 1
  63.       End If 
  64.       
  65.    End If 
  66.    
  67.    ' *** Check For Button Requester.
  68.    
  69.    If Upper$(CHAR$)="BUTTON"
  70.       
  71.       ' *** Call Button Requester. 
  72.       
  73.       _WBUTREQ["***Requester Choose_A_Button 1 2 3 4 5"]
  74.       
  75.       ' *** Display Number Of Button Selected (0 For Last Button Always).
  76.       
  77.       If ERR=-1
  78.          _WPRINT[1,"Button Selected = '"+Str$(BUT)-" "+"'"]
  79.          Print F$
  80.          Goto 1
  81.       End If 
  82.       
  83.    End If 
  84.    
  85.    ' *** Check For Close Gadget.
  86.    
  87.    If CHAR$=Space$(CHARS)
  88.       Goto FIN
  89.    End If 
  90.    
  91.    ' *** Check For EndCLI Command.  
  92.    
  93.    If Upper$(CHAR$)="ENDCLI"
  94.       Goto FIN
  95.    End If 
  96.    
  97.    ' *** Execute Anything Else Entered. 
  98.    
  99.    If CHAR$<>""
  100.       Print CHAR$
  101.       _WINDEXECUTE[1,CHAR$]
  102.    End If 
  103.    
  104. Loop 
  105.  
  106. ' *** Quit.
  107.  
  108. FIN:
  109.  
  110. ' *** Close Window.
  111.  
  112. _WINDCLOSE[1]
  113.  
  114. ' *** Get & Print Date.
  115.  
  116. _DATE
  117. Print "DATE  -  ";Param$
  118.  
  119. ' *** Get & Print Time.
  120.  
  121. _TIME
  122. Print "TIME  -  ";Param$
  123.  
  124. ' *** Bring Amos To Front & End. 
  125.  
  126. Amos To Front 
  127. End 
  128.  
  129. Procedure _WINDOPEN[N,X,Y,XX,YY,NAME$,CL]
  130.    
  131.    ' N      -  No of window.
  132.    ' X      -  Xpos of window.
  133.    ' Y      -  Ypos of window.
  134.    ' XX     -  Width of window. 
  135.    ' YY     -  Height of window.
  136.    ' NAME$  -  Title of window. 
  137.    ' CL     -  Close gadget 0=Off 1=On (WB2 Only).
  138.    
  139.    ' ERR    -  Output error code. 
  140.    
  141.    ' *** Give User Access To Error Code.
  142.    
  143.    Shared ERR,WINCON()
  144.    
  145.    ' *** Turn The X,Y,XX,YY,NAME$,CL Data Into Format Usable By DOS.
  146.    
  147.    X$=Str$(X)-" "
  148.    Y$=Str$(Y)-" "
  149.    XX$=Str$(XX)-" "
  150.    YY$=Str$(YY)-" "
  151.    CON$="CON:"+X$+"/"+Y$+"/"+XX$+"/"+YY$+"/"+NAME$
  152.    If CL=1
  153.       CON$=CON$+"/CLOSE"
  154.    End If 
  155.    CON$=CON$+Chr$(0)
  156.    
  157.    ' *** Call DOS Open Function.
  158.    
  159.    Dreg(1)=Varptr(CON$)
  160.    Dreg(2)=1005
  161.    WINCON(N)=Doscall(-30)
  162.    
  163.    If WINCON(N)=0
  164.       ERR=Doscall(-132)
  165.    End If 
  166.    
  167. End Proc
  168.  
  169. Procedure _WPRINT[N,M$]
  170.    
  171.    ' N    -  No of window.  
  172.    ' M$   -  Text to be printed.  
  173.    
  174.    ' ERR  -  Output error code. 
  175.    
  176.    ' *** Give User Access To Error Code.
  177.    
  178.    Shared ERR,WINCON()
  179.    
  180.    If WINCON(N)=0
  181.       Goto ERR
  182.    End If 
  183.    
  184.    ' *** Call The DOS Write Function. 
  185.    
  186.    Dreg(1)=WINCON(N)
  187.    Dreg(2)=Varptr(M$)
  188.    Dreg(3)=Len(M$)
  189.    X=Doscall(-48)
  190.    If X=0
  191.       Goto ERR
  192.    End If 
  193.    
  194.    Pop Proc
  195.    
  196.    ' *** In Case Of Error.
  197.    
  198.    ERR:
  199.    ERR=Doscall(-132)
  200.    
  201. End Proc
  202.  
  203. Procedure _WINPUT[N,NUM]
  204.    
  205.    ' N      -  No of window.
  206.    ' NUM    -  No of chars to read in.
  207.    
  208.    ' ERR    -  Output error code. 
  209.    ' CHAR$  -  Output text read in. 
  210.    ' CHARS  -  Output length read in. 
  211.    
  212.    ' *** Give User Access To Error Code And The String Entered. 
  213.    
  214.    Shared ERR,WINCON(),CHAR$
  215.    Global CHARS
  216.    
  217.    CHARS=NUM
  218.    
  219.    If WINCON(N)=0
  220.       Goto ERR
  221.    End If 
  222.    
  223.    ' *** Initialise Return Variable.
  224.    
  225.    CHAR$=Space$(NUM)
  226.    
  227.    ' *** Call DOS Read Function.
  228.    
  229.    Dreg(1)=WINCON(N)
  230.    Dreg(2)=Varptr(CHAR$)
  231.    Dreg(3)=NUM
  232.    X=Doscall(-42)
  233.    If X=0
  234.       Goto ERR
  235.    End If 
  236.    
  237.    A=Instr(CHAR$,Chr$(10))
  238.    If A>0
  239.       CHAR$=Mid$(CHAR$,1,A-1)
  240.    End If 
  241.    
  242.    Pop Proc
  243.    
  244.    ' *** In Case Of Error.
  245.    
  246.    ERR:
  247.    ERR=Doscall(-132)
  248.    
  249. End Proc
  250.  
  251. Procedure _WINDEXECUTE[N,COM$]
  252.    
  253.    ' N     -  No of window. 
  254.    ' COM$  -  Command to execute. 
  255.    
  256.    ' ERR   -  Output error. 
  257.    
  258.    ' *** Give User Access To Error Code.
  259.    
  260.    Shared ERR,WINCON()
  261.    
  262.    If WINCON(N)=0
  263.       Goto ERR
  264.    End If 
  265.    
  266.    ' *** Call The DOS Execute Function. 
  267.    
  268.    COM$=COM$+Chr$(0)
  269.    Dreg(1)=Varptr(COM$)
  270.    Dreg(2)=0
  271.    Dreg(3)=WINCON(N)
  272.    X=Doscall(-222)
  273.    If X=0
  274.       Goto ERR
  275.    End If 
  276.    
  277.    Pop Proc
  278.    
  279.    ' *** In Case Of Error.
  280.    
  281.    ERR:
  282.    ERR=Doscall(-132)
  283.    
  284. End Proc
  285.  
  286. Procedure _WINDCLOSE[N]
  287.    
  288.    ' N    -  No of window.
  289.    
  290.    ' ERR  -  Output error.
  291.    
  292.    ' *** Give The User Access To Error Code.
  293.    
  294.    Shared ERR,WINCON()
  295.    
  296.    If WINCON(N)=0
  297.       Goto ERR
  298.    End If 
  299.    
  300.    ' *** Call DOS Close Function. 
  301.    
  302.    Dreg(1)=WINCON(N)
  303.    X=Doscall(-36)
  304.    If X=0
  305.       Goto ERR
  306.    End If 
  307.    Pop Proc
  308.    
  309.    ' *** In case of error.
  310.    
  311.    ERR:
  312.    ERR=Doscall(-132)
  313.    
  314. End Proc
  315.  
  316. Procedure _WFILREQ[PTH$]
  317.    
  318.    ' PTH$  - Directory path.  
  319.    
  320.    ' *** Give User Access To Error Code And The Filename. 
  321.    
  322.    ' *** ERR = 0  : File-Requester Program Not Found.   
  323.    '     ERR = -1 : File-Requester Program Found.   
  324.    
  325.    Shared ERR,FIL$
  326.    
  327.    ' *** Check For Requester Program. 
  328.    
  329.    If Not Exist("C:RequestFile")
  330.       ERR=0
  331.       Pop Proc
  332.    End If 
  333.    
  334.    ' *** Execute Requester Program. 
  335.    
  336.    _WINDEXECUTE[1,"C:RequestFile >Ram:AMOS-Temp.001 "+Chr$(34)+PTH$+Chr$(34)]
  337.    
  338.    ' *** Read In Selected File. 
  339.    
  340.    Open In 1,"Ram:AMOS-Temp.001"
  341.    F$=Input$(1,Lof(1))
  342.    Close 1
  343.    
  344.    ' *** Delete Temp File.
  345.    
  346.    Kill "Ram:AMOS-Temp.001"
  347.    
  348.    ' *** Arrange Filename Into String.
  349.    
  350.    I=Instr(F$,Chr$(34),2)
  351.    FIL$=Mid$(F$,2,I-2)
  352.    
  353.    ' *** Set Error Code.
  354.    
  355.    ERR=-1
  356.    
  357. End Proc
  358.  
  359. Procedure _WBUTREQ[DEF$]
  360.    
  361.    ' DEF$ - Default requester line, this line sets up the message & buttons.
  362.    
  363.    ' *** Give User Access To Error Code And The Button No Selected. 
  364.    
  365.    ' *** ERR = 0  : Button-Requester Program Not Found.   
  366.    '     ERR = -1 : Button-Requester Found.   
  367.    
  368.    Shared ERR,BUT
  369.    
  370.    ' *** Check For Requester Program. 
  371.    
  372.    If Not Exist("C:RequestChoice")
  373.       ERR=0
  374.       Pop Proc
  375.    End If 
  376.    
  377.    ' *** Execute Button Program.
  378.    
  379.    _WINDEXECUTE[1,"Sys:c/RequestChoice >Ram:AMOS-Temp.001 "+DEF$]
  380.    
  381.    ' *** Read In Selected Button. 
  382.    
  383.    Open In 1,"Ram:AMOS-Temp.001"
  384.    F$=Input$(1,Lof(1))
  385.    Close 1
  386.    
  387.    ' *** Delete Temp File.
  388.    
  389.    Kill "Ram:AMOS-Temp.001"
  390.    
  391.    ' *** Arrange Button Selected Into A Variable. 
  392.    
  393.    For I=Len(F$)-1 To 1 Step -1
  394.       Exit If Mid$(F$,LOP,1)<>" "
  395.    Next I
  396.    
  397.    BUT=Val(Left$(F$,I))
  398.    
  399.    ' *** Set Error Message. 
  400.    
  401.    ERR=-1
  402.    
  403. End Proc
  404.  
  405. Procedure _DATE
  406.    
  407.    ' Param$  -  Output data string. 
  408.    
  409.    ' *** Call DOS DateStamp Function. 
  410.    
  411.    T$=Space$(12)
  412.    Dreg(1)=Varptr(T$)
  413.    RIEN=Doscall(-192)
  414.    NJ=Leek(Varptr(T$))
  415.    
  416.    ' *** Find This Year's First Day.
  417.    
  418.    A=1978
  419.    JOUR=7
  420.    Do 
  421.       BIS=0
  422.       If(A and 3)=0
  423.          BIS=1
  424.       End If 
  425.       Exit If NJ-365-BIS<0
  426.       Add JOUR,1+BIS
  427.       If JOUR>7
  428.          Add JOUR,-7
  429.       End If 
  430.       Add NJ,-365-BIS
  431.       Inc A
  432.    Loop 
  433.    
  434.    ' *** Find Month.
  435.    
  436.    M=1
  437.    Do 
  438.       Read N
  439.       Exit If NJ-N<0
  440.       Add NJ,-N
  441.       Inc M
  442.    Loop 
  443.    Inc NJ
  444.    
  445.    ' *** Fabrique La Chaine.
  446.    
  447.    J$=Mid$(Str$(NJ),2)
  448.    If Len(J$)<2
  449.       J$="0"+J$
  450.    End If 
  451.    M$=Mid$(Str$(M),2)
  452.    If Len(M$)<2
  453.       M$="0"+M$
  454.    End If 
  455.    A$=Mid$(Str$(A),2)
  456.    DATE$=J$+"-"+M$+"-"+A$
  457.    
  458.    ' *** Length Of Each Month.
  459.    
  460.    Data 31,28+BIS,31,30,31,30,31,31,30,31,30,31
  461.    
  462. End Proc[DATE$]
  463.  
  464. Procedure _TIME
  465.    
  466.    ' Param$  -  Output time string. 
  467.    
  468.    ' *** Call DOS Function. 
  469.    
  470.    T$=Space$(12)
  471.    Dreg(1)=Varptr(T$)
  472.    RIEN=Doscall(-192)
  473.    MN=Leek(Varptr(T$)+4)
  474.    SEC=Leek(Varptr(T$)+8)
  475.    
  476.    ' *** Minutes calculation. 
  477.    
  478.    H=MN/60
  479.    H$=Mid$(Str$(H),2)
  480.    If Len(H$)<2
  481.       H$="0"+H$
  482.    End If 
  483.    M=MN mod 60
  484.    M$=Mid$(Str$(M),2)
  485.    If Len(M$)<2
  486.       M$="0"+M$
  487.    End If 
  488.    
  489.    ' *** Seconds calculation. 
  490.    
  491.    S=SEC/50
  492.    S$=Mid$(Str$(S),2)
  493.    If Len(S$)<2
  494.       S$="0"+S$
  495.    End If 
  496.    
  497.    ' *** Final String.
  498.    
  499.    TIME$=H$+":"+M$+":"+S$
  500.    
  501. End Proc[TIME$]